home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / ERRINS.ZIP;1 / ERRDEMO.PRG next >
Encoding:
Text File  |  1992-04-01  |  8.8 KB  |  530 lines
  1. /***
  2. *
  3. *  ErrDemo.prg
  4. *    Demonstration of the Error Inspector, a diagnostic error handler
  5. *    for Clipper 5.0, version 5.01.
  6. *
  7. *  Copyright (c) 1992 Nantucket Corp.  All rights reserved
  8. *
  9. *  Compile with /m /n /w
  10. *
  11. */
  12.  
  13. #include "Box.ch"
  14. #include "Inkey.ch"
  15.  
  16. MEMVAR cMacroExp
  17. FIELD Key
  18.  
  19. // manifest constant used to control whether or not a message is
  20. // displayed when a BREAK is issued. Helpful for differentiating
  21. // BREAKs from default recovery.
  22. //
  23. #define MESSAGE_ON_BREAK  .F.
  24.  
  25. #define ERR_DESCRIPTION    1
  26. #define ERR_BLOCK          2
  27.  
  28. #define FILL_PATTERN       CHR( 176 )
  29.  
  30. // number of sample records to create
  31. //
  32. #define SAMPLE_RECS       5
  33.  
  34. // center row and column pseudo functions
  35. //
  36. #define CROW()     INT( MAXROW() / 2 )
  37. #define CCOL()     INT( MAXCOL() / 2 )
  38.  
  39. /***
  40. *
  41. *  MakeError()
  42. *  
  43. *    Generate an error to test the Error Inspector.
  44. *
  45. */
  46. PROCEDURE MakeError()
  47.     LOCAL aError := { ;
  48.         { "No Variable", {|| NoVariable() } }, ;
  49.         { "Open Error", {|| OpenError() } }, ;
  50.         { "Type Mismatch", {|| MisMatch() } }, ;
  51.         { "Complexity", {|| Complexity() } }, ;
  52.         { "String Overflow", {|| Overflow() } }, ;
  53.         { "Bound Violation", {|| BoundViolation() } }, ;
  54.         { "No Exported Method", {|| NoExpMethod() } }, ;
  55.         { "Data Width Error", {|| DataWidth() } }, ;
  56.         { "Data Type Error", {|| DataType() } }, ;
  57.         { "File Corruption", {|| Corruption() } }, ;
  58.         { "No Alias", {|| NoAlias() } }, ;
  59.         { "Undefined Function", {|| UndefFunction() } } ;
  60.         }
  61.  
  62.     LOCAL nErrPtr
  63.     LOCAL nChoice := 0
  64.     // calculate dimensions of menu
  65.     //
  66.     LOCAL nWidth := MaxPromptLen( aError )
  67.     LOCAL nHeight := LEN( aError )
  68.     LOCAL nTop := CROW() - ( ( nHeight + 1 ) / 2 )
  69.     LOCAL nLeft := CCOL() - ( ( nWidth + 3 ) / 2 )
  70.     LOCAL nBottom := nTop + ( nHeight + 1 )
  71.     LOCAL nRight := nLeft + ( nWidth + 3 )
  72.  
  73.     SET EXCLUSIVE ON
  74.  
  75.     CreateFiles()
  76.  
  77.     @ 0, 0, MAXROW(), MAXCOL() BOX REPLICATE( FILL_PATTERN, 9 )
  78.  
  79.     @ nTop, nLeft, nBottom, nRight BOX B_SINGLE + SPACE( 1 )
  80.  
  81.     @ nTop, nLeft + 1 SAY " Error du jour "
  82.  
  83.     nChoice := 1
  84.  
  85.     DO WHILE ! EMPTY( nChoice )
  86.  
  87.         // Add prompts from the error menu array
  88.         //
  89.         FOR nErrPtr := 1 TO LEN( aError )
  90.         
  91.             @ nTop + nErrPtr, nLeft + 2 PROMPT aError[ nErrPtr, ERR_DESCRIPTION ]
  92.  
  93.         NEXT nErrPtr
  94.         
  95.         MENU TO nChoice
  96.  
  97.         IF ! EMPTY( nChoice )
  98.             Are( aError[ nChoice, ERR_BLOCK ] )
  99.  
  100.         ENDIF
  101.  
  102.     ENDDO
  103.  
  104.     KillFiles()
  105.  
  106.     @ MAXROW() + 1, 0
  107.  
  108.     RETURN
  109.  
  110. /***
  111. *
  112. *  Are( <bBadBlock> )
  113. *
  114. *  Just building a respectable callstack; we just pass the code block
  115. *    along.
  116. *
  117. */
  118. STATIC PROCEDURE Are( bBadBlock )
  119.  
  120.     You( bBadBlock )
  121.  
  122.     RETURN
  123.  
  124. /***
  125. *
  126. *  You( <bBadBlock> )
  127. *
  128. *  Still building the callstack; we just pass the code block along.
  129. *
  130. */
  131. STATIC PROCEDURE You( bBadBlock )
  132.  
  133.     Reading( bBadBlock )
  134.  
  135.     RETURN
  136.  
  137. /***
  138. *
  139. *  Reading( <bBadBlock> )
  140. *
  141. *  Still going...
  142. *
  143. */
  144. STATIC PROCEDURE Reading( bBadBlock )
  145.     
  146.     This( bBadBlock )
  147.  
  148.     RETURN
  149.  
  150. /***
  151. *
  152. *  This( <bBadBlock> )
  153. *
  154. *  Still going...
  155. *
  156. */
  157. STATIC PROCEDURE This( bBadBlock )
  158.  
  159.     Upside( bBadBlock )
  160.  
  161.     RETURN
  162.  
  163. /***
  164. *
  165. *  Upside( <bBadBlock> )
  166. *
  167. *  Still going...
  168. *
  169. */
  170. STATIC PROCEDURE Upside( bBadBlock )
  171.  
  172.     Down( bBadBlock )
  173.  
  174.     RETURN
  175.  
  176. /***
  177. *
  178. *  Down( <bBadBlock> )
  179. *
  180. *  Create a local recovery context to cushion the fall and launch
  181. *    the error.
  182. *
  183. */
  184. STATIC PROCEDURE Down( bBadBlock )
  185.     LOCAL oErrObject
  186.     LOCAL cMessage := ""
  187.  
  188.     BEGIN SEQUENCE
  189.         EVAL( bBadBlock )
  190.  
  191.     RECOVER USING oErrObject
  192.  
  193.         UNLOCK
  194.  
  195.         IF MESSAGE_ON_BREAK
  196.  
  197.             cMessage := "Recovering from : " + oErrObject:description
  198.  
  199.             // place message at center of screen
  200.             //
  201.             ErrMsg( cMessage, CROW() - 2, CCOL() - ( LEN( cMessage ) / 2 ) )
  202.  
  203.         ENDIF
  204.  
  205.     END SEQUENCE
  206.  
  207.     RETURN
  208.  
  209. /***
  210. *
  211. *  NoVariable()
  212. *
  213. *  Generate a "No Variable" error.
  214. *
  215. */
  216. STATIC PROCEDURE NoVariable
  217.     MEMVAR xUnknown
  218.     LOCAL xResult
  219.  
  220.     xResult := xUnknown / 5
  221.  
  222.     RETURN
  223.  
  224. /***
  225. *
  226. *  OpenError()
  227. *
  228. *  Generate an "Open Error".
  229. *
  230. */
  231. STATIC PROCEDURE OpenError
  232.     LOCAL cFileName := "_@@@@@@.$$$"
  233.  
  234.     USE (cFileName) NEW
  235.  
  236.     RETURN
  237.  
  238. /***
  239. *
  240. *  MisMatch()
  241. *
  242. *  Generate a "Type Mismatch" error.
  243. *
  244. */
  245. STATIC PROCEDURE MisMatch
  246.     LOCAL nValue := 1
  247.     LOCAL cValue := "Mistake"
  248.     LOCAL xResult 
  249.  
  250.     xResult := nValue * cValue
  251.  
  252.     RETURN
  253.  
  254. /***
  255. *
  256. *  Complexity()
  257. *
  258. *  Feed the macro processor something substantial to chew on.
  259. *
  260. */
  261. STATIC PROCEDURE Complexity
  262.     LOCAL xResult
  263.     PRIVATE cMacroExp := ".T." + REPLICATE( " .AND. .T.", 200 )
  264.     xResult := &( cMacroExp )
  265.  
  266.     RETURN
  267.  
  268. /***
  269. *
  270. *  Overflow()
  271. *
  272. *  Generate a "String Overflow" error.
  273. *
  274. */
  275. STATIC PROCEDURE Overflow
  276.     LOCAL cLong := SPACE( 32000 )
  277.     LOCAL cRealLong := SPACE( 64000 )
  278.  
  279.     cLong += cRealLong
  280.  
  281.     RETURN
  282.  
  283. /***
  284. *
  285. *  BoundViolation()
  286. *
  287. *  Generate a "Bound Violation" error.
  288. *
  289. */
  290. STATIC PROCEDURE BoundViolation
  291.     LOCAL aArray
  292.  
  293.     // One more element than is possible in a single dimension...
  294.     aArray := ARRAY( 4097 )
  295.  
  296.     RETURN
  297.  
  298. /***
  299. *
  300. *  NoExpMethod()
  301. *
  302. *  Generate a "No Exported Method" error.
  303. *
  304. */
  305. STATIC PROCEDURE NoExpMethod
  306.     LOCAL cDecoyObject := "Not an Object"
  307.  
  308.     cDecoyObject:interrogate()
  309.  
  310.     RETURN
  311.  
  312. /***
  313. *
  314. *  Corruption()
  315. *
  316. *  Generate a "Corruption Detected" error.
  317. *
  318. */
  319. STATIC PROCEDURE Corruption
  320.     LOCAL cFileName := "ERRDEMO.EXE"
  321.  
  322.     USE (cFileName) EXCLUSIVE NEW
  323.  
  324.     RETURN
  325.  
  326. /***
  327. *
  328. *  DataWidth()
  329. *
  330. *  Generate a "Data Width" error.
  331. *
  332. */
  333. STATIC PROCEDURE DataWidth
  334.     LOCAL nKey := 99999999999.99
  335.  
  336.     XSample->Key := nKey
  337.  
  338.     RETURN
  339.  
  340. /***
  341. *
  342. *  DataType()
  343. *
  344. *  Generate a "Data Type" error.
  345. *
  346. */
  347. STATIC PROCEDURE DataType
  348.     LOCAL cKey := ""
  349.  
  350.     RLOCK()
  351.  
  352.     XSample->Key := cKey
  353.  
  354.     RETURN
  355.  
  356. /***
  357. *
  358. *  UndefFunction()
  359. *
  360. *  Generate an "Undefined Function" error.
  361. *
  362. */
  363. STATIC PROCEDURE UndefFunction
  364.     LOCAL xResult
  365.     PRIVATE cMacroExp := "SONICYOUTH()"
  366.     xResult := &( cMacroExp )
  367.  
  368.     RETURN
  369.  
  370. /***
  371. *
  372. *  NoAlias()
  373. *
  374. *  Generate an "No Alias" error.
  375. *
  376. */
  377. STATIC PROCEDURE NoAlias
  378.     LOCAL xResult
  379.     PRIVATE cMacroExp := "Mystery"
  380.     xResult := &( cMacroExp )->Key
  381.  
  382.     RETURN
  383.  
  384. /***
  385. *
  386. *  CreateFiles()
  387. *
  388. *  Create sample tables, populate with data.
  389. *
  390. *
  391. */
  392. STATIC PROCEDURE CreateFiles()
  393.     LOCAL bPrevError := ERRORBLOCK( {|oErr| BREAK( oErr ) } )
  394.     LOCAL nRecPtr
  395.     LOCAL oLocErr
  396.  
  397.     BEGIN SEQUENCE
  398.         BuildTables()
  399.  
  400.         USE Damage ALIAS Damage NEW READONLY
  401.         SET INDEX TO Damage
  402.  
  403.         USE XSample ALIAS XSample NEW
  404.         SET INDEX TO XSample
  405.  
  406.         SET FILTER TO XSample->Key > 3
  407.         SET RELATION TO XSample->Key INTO Damage
  408.  
  409.     RECOVER USING oLocErr
  410.         // if we end up here, we run the demo with no sample tables
  411.         //
  412.         CLOSE DATABASES
  413.  
  414.     END SEQUENCE
  415.  
  416.     ERRORBLOCK( bPrevError )
  417.  
  418.     RETURN
  419.  
  420. /***
  421. *
  422. *  BuildTables()
  423. *
  424. *  Create sample tables for the Error Inspector demo.
  425. *
  426. */
  427. STATIC PROCEDURE BuildTables()
  428.  
  429.     // names of the tables to create
  430.     //
  431.     LOCAL aTables := { "DAMAGE", "XSAMPLE" }
  432.  
  433.     // array to store all structure definitions
  434.     //
  435.     LOCAL aStructs := {}
  436.  
  437.     // structure of the Damage table
  438.     //
  439.     LOCAL aDamage := { ;
  440.         { "KEY",       "N",   6,  0 }, ;
  441.         { "REGION",    "N",   6,  0 }, ;
  442.         { "ZONE",         "C",   4,  0 }, ;
  443.         { "DATE",      "D",   8,  0 }, ;
  444.         { "DESC",      "C",  20,  0 }, ;
  445.         { "DAMAGE",    "N",  14,  2 } ;
  446.     }
  447.  
  448.     // structure of the XSample table
  449.     //
  450.     LOCAL aXSample := { ;
  451.         { "KEY",            "N",  10,  0 }, ; 
  452.         { "INT",            "N",    10,  0 }, ;
  453.         { "SIGNED",        "N",    11,  0 }, ;
  454.         { "FLOAT",        "N",    18,  6 }, ;
  455.         { "DOUBLE",        "N",    18,  6 }, ;
  456.         { "DECIM",        "N",    14,  2 }, ;
  457.         { "DATE",        "D",     8,  0 }, ;
  458.         { "CODE",        "C",    10,  0 }, ;
  459.         { "NAME",        "C",  20,  0 }, ;
  460.         { "ADDRESS",   "C",    80,  0 }  ;
  461.     }
  462.  
  463.     // Table pointer, used to index the structure and table name arrays
  464.     //
  465.     LOCAL nTablePtr
  466.     LOCAL nRecPtr
  467.  
  468.     // place all structure definitions into an array. This enables
  469.     // us to generalize the table creation process.
  470.     // 
  471.     AADD( aStructs, aDamage )
  472.     AADD( aStructs, aXSample )
  473.  
  474.     // create all tables in a single pass through the array
  475.     //
  476.     FOR nTablePtr := 1 TO LEN( aTables )
  477.         
  478.         DBCREATE( aTables[ nTablePtr ], aStructs[ nTablePtr ] )
  479.  
  480.         USE ( aTables[ nTablePtr] ) ALIAS ( aTables[ nTablePtr ] ) NEW
  481.  
  482.         // add a few dummy records
  483.         //
  484.         FOR nRecPtr := 1 TO SAMPLE_RECS
  485.             APPEND BLANK
  486.             ( aTables[ nTablePtr ] )->Key := nRecPtr
  487.  
  488.         NEXT nRecPtr
  489.  
  490.         INDEX ON Key TO ( aTables[ nTablePtr ] )
  491.  
  492.         USE
  493.  
  494.     NEXT nTablePtr
  495.  
  496.     RETURN
  497.  
  498. /***
  499. *
  500. *  KillFiles()
  501. *
  502. *  Delete the sample tables from disk if present.
  503. *
  504. *
  505. */
  506. STATIC PROCEDURE KillFiles()
  507.  
  508.     CLOSE DATABASES
  509.     FERASE( "Damage.dbf" )
  510.     FERASE( "Damage.ntx" )
  511.     FERASE( "XSample.dbf" )
  512.     FERASE( "XSample.ntx" )
  513.  
  514.     RETURN
  515.  
  516. /***
  517. *
  518. *  MaxPromptLen( <aArray> ) --> nLength
  519. *
  520. *  Determine the maximum length of a prompt in a two-dimensional array.
  521. *
  522. */
  523. STATIC FUNCTION MaxPromptLen( aArray )
  524.     LOCAL nLength := 0
  525.  
  526.     AEVAL( aArray, {|aElement| nLength := ;
  527.         MAX( LEN( aElement[ ERR_DESCRIPTION ] ), nLength ) } )
  528.  
  529.     RETURN ( nLength )
  530.